Attribute VB_Name = "mdlCommon"
Option Explicit

Public Const LOGPIXELSY = 90
Public Const LF_FACESIZE = 32

Public Enum CF_
    CF_APPLY = &H200&
    CF_ANSIONLY = &H400&
    CF_TTONLY = &H40000
    CF_ENABLEHOOK = &H8&
    CF_ENABLETEMPLATE = &H10&
    CF_ENABLETEMPLATEHANDLE = &H20&
    CF_FIXEDPITCHONLY = &H4000&
    CF_NOVECTORFONTS = &H800&
    CF_NOOEMFONTS = CF_NOVECTORFONTS
    CF_NOFACESEL = &H80000
    CF_NOSCRIPTSEL = &H800000
    CF_NOSTYLESEL = &H100000
    CF_NOSIZESEL = &H200000
    CF_NOSIMULATIONS = &H1000&
    CF_NOVERTFONTS = &H1000000
    CF_SCALABLEONLY = &H20000
    CF_SCRIPTSONLY = CF_ANSIONLY
    CF_SELECTSCRIPT = &H400000
    CF_SHOWHELP = &H4&
    CF_USESTYLE = &H80&
    CF_WYSIWYG = &H8000
    CF_FORCEFONTEXIST = &H10000
    CF_INITTOLOGFONTSTRUCT = &H40&
    CF_SCREENFONTS = &H1
    CF_PRINTERFONTS = &H2
    CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
    CF_EFFECTS = &H100&
    CF_LIMITSIZE = &H2000&
End Enum

Public Type ChooseFont
    lStructSize As Long
    hwndOwner As Long
    hdc As Long
    lpLogFont As Long
    iPointSize As Long
    flags As Long
    rgbColors As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
    hInstance As Long
    lpszStyle As String
    nFontType As Integer
    MISSING_ALIGNMENT As Integer
    nSizeMin As Long
    nSizeMax As Long
End Type

Public Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * LF_FACESIZE
End Type

Public Declare Function MulDiv Lib "Kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Public Declare Function GetDeviceCaps Lib "GDI32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowPos& Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Public Declare Function ChooseFont Lib "ComDLG32" Alias "ChooseFontA" (pChoosefont As ChooseFont) As Long
Public Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function ShellExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_SHOWNORMAL = 1

Public strBase As String

Public Function GetKeyCodeFromLog(ByVal sApplication As String, ByVal sKeyName As String, ByVal sDefault As String, ByVal sFilename As String) As String
    On Error Resume Next
    Dim sReturn As String, lNC As Long
    sReturn = String(255, 0)
    lNC = GetPrivateProfileString(sApplication, sKeyName, sDefault, sReturn, 255, sFilename)
    sReturn = Left(sReturn, InStr(sReturn, Chr(0)) - 1)
    GetKeyCodeFromLog = Trim$(sReturn)
End Function

Public Function ResolveString(ByVal sString As String, ParamArray varReplacements() As Variant) As String
    On Error Resume Next
    Dim intMacro As Integer
    Dim strResString As String
    Dim intPos As Integer
    Dim strMacro As String
    Dim strValue As String
    strResString = sString
    For intMacro = LBound(varReplacements) To UBound(varReplacements) Step 2
        strMacro = varReplacements(intMacro)
        On Error GoTo MismatchedPairs
        strValue = varReplacements(intMacro + 1)
        On Error GoTo 0
        Do
            intPos = InStr(strResString, strMacro)
            If intPos > 0 Then
                strResString = Left$(strResString, intPos - 1) & strValue & Right$(strResString, Len(strResString) - Len(strMacro) - intPos + 1)
            End If
        Loop Until intPos = 0
    Next intMacro
    ResolveString = strResString
    Exit Function
MismatchedPairs:
    Resume Next
End Function

Public Function IntoPath(ByVal strSourceDirectory As String, ByVal strFilename As String) As String
    On Error Resume Next
    If Right(strSourceDirectory, 1) = "\" Then
        IntoPath = strSourceDirectory & strFilename
    Else
        IntoPath = strSourceDirectory & "\" & strFilename
    End If
End Function

Public Function IsFileOrDirectoryExist(ByVal sPath As String, Optional bDirectory As Boolean = False) As Boolean
    On Error Resume Next
    Dim sReturn As String
    IsFileOrDirectoryExist = False
    sReturn = vbNullString
    If bDirectory = True Then
        sReturn = Dir(sPath, vbSystem + vbReadOnly + vbHidden + vbDirectory)
    Else
        sReturn = Dir(sPath, vbSystem + vbReadOnly + vbHidden)
    End If
    If sReturn = vbNullString Then
        IsFileOrDirectoryExist = False
    Else
        IsFileOrDirectoryExist = True
    End If
End Function

Public Sub Main()
    On Error Resume Next
    Dim sTitle As String
    strBase = App.Path
    If App.PrevInstance = True Then
        sTitle = App.Title
        App.Title = App.CompanyName & " : " & App.EXEName
        AppActivate sTitle
        End
    End If
    Call InitialConversion
    Load frmMain
    frmMain.Show
    Exit Sub
End Sub
